Collection of Tools & Utilities/Collection of Tools and Utilities.iso/graphic/tpega.zip/ART.PAS

Pascal/Delphi Source File | 1986-01-26 | 4KB | 215 lines

Program ArtExample;
{
          ART DEMONSTRATION PROGRAM  Version 1.00A

     This program demonstrates the use of color graphics
     using TURBO PASCAL on the IBM PC and true compatibles
     with a color graphics adapter.

     INSTRUCTIONS
     1.  Compile and run this program using the TURBO.COM
         compiler.
     2.  Type <ESC> to exit the program, any other key to
         regenerate the screen.


     MODIFIED by Kent Cedola to use EGA Graphic Primitives.

}

const
  MemorySize = 200;

var
  X1, X2, Y1, Y2,
  CurrentLine,
  ColorCount,
  IncrementCount,
  DeltaX1, DeltaY1, DeltaX2, DeltaY2,
  I, Color: integer;
  Ch: char;
  Line: array [1..MemorySize] of record
                                   LX1, LY1: integer;
                                   LX2, LY2: integer;
                                   LColor:  integer;
                                 end;

{$I GPPARMS.P }
{$I GPINIT.P  }
{$I GPTERM.P  }
{$I GPCOLOR.P }
{$I GPMOVE.P  }
{$I GPLINE.P  }
{$I GPVIEWPO.P }

procedure Check;
var
  ch: char;
begin

  GPPARMS;

  if GDTYPE <> 5 then
    begin
    ClrScr;
    Writeln('Enhanced Graphic Adapter and Display not found!');
    Halt(1);
    end;

  if GDMEMORY = 64 then
    begin
    ClrScr;
    Writeln('This program works much better with 128k or more EGA memory!');
    Writeln;
    Writeln('   Hit any key to continue...');
    Read(KBd,Ch);
    end;

end;

procedure Init;
begin

  GPINIT;
  GPVIEWPORT(50,50,300,300);
  for I := 1 to MemorySize do
  with Line[I] do
  begin
    LX1 := 0;
    LX2 := 0;
    LY1 := 0;
    LY2 := 0;
  end;
  X1 := 0;
  Y1 := 0;
  X2 := 0;
  Y2 := 0;
  CurrentLine := 1;
  ColorCount := 0;
  IncrementCount := 0;
  Ch := ' ';
  GPCOLOR(2);
  Color := 2;
  gotoxy(1,25);
  write('Press any key to regenerate, ESC to stop');
end;

procedure AdjustX(var X,DeltaX: integer);
var
  TestX: integer;
begin
  TestX := X+DeltaX;
  if (TestX<1) or (TestX>GDMAXCOL - 1) then
  begin
    TestX := X;
    DeltaX := -DeltaX;
  end;
  X := TestX;
end;

procedure AdjustY(var Y,DeltaY: integer);
var
  TestY: integer;
begin
  TestY := Y+DeltaY;
  if (TestY<1) or (TestY> GDMAXROW - 32) then
  begin
    TestY := Y;
    DeltaY := -DeltaY;
  end;
  Y := TestY;
end;

procedure SelectNewColor;
begin
  Color := Random(GDMAXPAL-1)+1;
  ColorCount := 5*(1+Random(10));
end;

procedure SelectNewDeltaValues;
begin
  DeltaX1 := Random(7)-3;
  DeltaX2 := Random(7)-3;
  DeltaY1 := Random(7)-3;
  DeltaY2 := Random(7)-3;
  IncrementCount := 4*(1+Random(9));
end;

procedure SaveCurrentLine;
begin
  with Line[CurrentLine] do
  begin
    LX1 := X1;
    LY1 := Y1;
    LX2 := X2;
    LY2 := Y2;
    LColor := Color;
  end;
end;

procedure Regenerate;
var
  I: integer;
begin
  NoSound;
  GPINIT;
  for I := 1 to MemorySize do
    with Line[I] do
      begin
      GPCOLOR(LColor);
      GPMOVE(LX1,LY1);
      GPLINE(LX2,LY2);
      end;
  gotoxy(1,25);
  write('Press any key to continue, ESC to stop');
  read(Kbd,Ch);
end;

procedure WanderingLines;
begin
  repeat
    repeat
      with Line[CurrentLine] do
        begin
        GPCOLOR(Black);
        GPMOVE(LX1,LY1);
        GPLINE(LX2,LY2);
        end;

      if ColorCount=0 then SelectNewColor;
      if IncrementCount=0 then SelectNewDeltaValues;

      AdjustX(X1,DeltaX1);
      AdjustY(Y1,DeltaY1);
      AdjustX(X2,DeltaX2);
      AdjustY(Y2,DeltaY2);

      GPCOLOR(Color);
      GPMOVE(X1,Y1);
      GPLINE(X2,Y2);

      SaveCurrentLine;

      CurrentLine := Succ(CurrentLine);
      if CurrentLine>MemorySize then CurrentLine := 1;
      ColorCount := Pred(ColorCount);
      IncrementCount := Pred(IncrementCount);
    until KeyPressed;
    read(Kbd,Ch);
    if Ch <> #27 then
    begin
      Regenerate;
      gotoxy(1,25);
      write('Press any key to regenerate, ESC to stop');
    end;
  until Ch = #27;
end;

begin
  ClrScr;
  Check;
  Init;
  WanderingLines;
  TextMode;
end.